Delphi 2 - Developers' Solutions/Delphi 2 Developers' Solutions.iso/dds/chap11/howto05/ccuucode.pas

Pascal/Delphi Source File | 1996-02-27 | 36.4 KB | 1,044 lines

unit CCUUCode;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Menus, FileCtrl;

const UUDefaultSuffix = '.UUO'; { Use this if no valid output suffix }
      UUDefaultOuputSuffix = '.UUE'; { Use this for all encodings }
      UUCodingOffset = 32; { This is standard offset for UU Coding }
      CDV_ENCODE = 1; { Data vector for encoding }
      CDV_DECODE = 2; { Data vector for decoding }
      CIV_FILE   = 1; { Input vector for file }
      CIV_STREAM = 2; { Input vector for stream }
      CIV_SLIST  = 3; { Input vector for string list }
      COV_FILE   = 1; { Output vector for file }
      COV_STREAM = 2; { Output vector for stream }
      COV_SLIST  = 3; { Output vector for string list }
      CMV_SINGLE = 0; { Multifile vector single file }
      CMV_MULTI  = 1; { Multifile vector multiple files }
      EC_NOBEGIN = -1; { Error code for no Begin found }
      EC_EOF     = -2; { Error code for unexpected end of file }
      EC_EMPTYDATALINE = -3; { Error code for empty line in data }
      EC_UEODL = -4; { Error code for unexpected end of data line }
      EC_INVALIDCHAR = -5; { Error code for invalid char in stream }
      EC_OUTPUTFILEERROR = -6; { Error code for failure on opening output file }
      EC_INPUTFILEERROR = -7; { Error code for failure on opening input file }

type
  TUUErrorEvent = procedure( ErrorCode : Integer; ErrorMessage : String )
   of object;
  TUUUpdateEvent = procedure( BytesCompleted , TotalBytes : LongInt )
   of object;
  { This object handles decoding streams, files (multiples), and output }
  { to streams or files.                                                }
  TUUCodingObject = class( TWinControl )
  private { hidden stuff }
    FOnUUErrorOccurred : TUUErrorEvent;
    FOnOutputStatus    : TUUUpdateEvent;
  public { public stuff }
    CurrentInputFileName    : String;
    CurrentOutputFileName   : String;
    TheMultipleFilesList    : TStringList;
    TheEncodingOutputFile ,
    TheInputFile            : TextFile;
    TheEncodingInputFile ,
    TheOutputFile           : File of Byte;
    CurrentMFInPointer      : Integer;
    CurrentLineNumber       : integer;
    CurrentLine             : string;
    CurrentErrorCode        : Integer;
    CurrentErrorMessage     : String;
    CurrentMultifileVector  : Integer;
    constructor Create( AOwner : TComponent ); override;
    destructor Destroy; override;
    procedure UUError( ECode : Integer; EMsg : String );
    procedure UUUpdate( BSF , BT : LongInt );
    function GetTextFileSize( TheName : String ) : Longint;
    function SetInputFileName( TheName : String ) : Boolean;
    procedure SetMultipleFilesList( TheList : TStringList );
    function DecodeOutputName( TheInputString : String ) : String;
    procedure SetMultiFileVector( TheVector : Integer );
    procedure GetNextInputFileLine( var OutputString : string );
    procedure DecodeLine;
    function StartDecoding : Boolean;
    function Decode : Boolean;
    function DecodeCurrentInputs : Boolean;
    function EncodeCurrentInputs : Boolean;
    procedure AbortCoding( AbortCode : Integer; AbortMessage : String );
    procedure GetNextSDWord(     TheInputString : String;
                             var WordGotten     : string;
                             var PositionIndex  : integer );
    function GetAUsableSingleExtensionFileName( InputName : String ) : String;
    function ScanLinesforDecodeStartup : String;
    function ScanLinesforBEGINEND( Vector : Integer ) : Boolean;
    function CheckForBEGIN_ENDLine( InputLine : String; Vector : Integer ) : boolean;
    function CheckForValidLine : boolean;

    property OnUUErrorOccurred : TUUErrorEvent read FOnUUErrorOccurred
     write FOnUUErrorOccurred;
    property OnOutputStatus : TUUUpdateEvent read FOnOutputStatus
     write FOnOutputStatus;
  end;
var
  TotalBytesSoFar ,
  TotalBytesToDo    : Longint;

implementation

uses CCICCFRM;

{ Create call }
constructor TUUCodingObject.Create( AOwner : TComponent );
begin
  { Inherited create }
  inherited Create( AOwner );
  { set all internals to neutral }
  CurrentMFInPointer      := 0;
  CurrentLineNumber       := 0;
  CurrentLine             := '';
  CurrentErrorCode        := 0;
  CurrentErrorMessage     := '';
  CurrentMultifileVector  := CMV_SINGLE;
  FOnUUErrorOccurred := UUError;
  FOnOutputStatus    := UUUpdate;

end;

{ Replacement destroy; currently does nada }
destructor TUUCodingObject.Destroy;
begin
  { call inherited }
  Inherited Destroy;
end;

{ This is the generic error handler }
procedure TUUCodingObject.UUError( ECode : Integer; EMsg : String );
begin
  { Do generic MessageBox }
  MessageDlg( 'A UUCode error code ' + IntToStr( ECode ) +
   ' has happend with Message ' + EMsg , mtError , [mbOK] , 0 );
end;

{ This is the generic update procedure }
procedure TUUCodingObject.UUUpdate( BSF , BT : LongInt );
begin
  CCInetCCForm.UpdateUUGauge( BSF , BT );
end;

{ This is a clever function to get the total bytes of a text file }
function TUUCodingObject.GetTextFileSize( TheName : String ) : Longint;
var TheSR : TSearchRec; { Used for trick }
begin
  { This allows getting the data }
  FindFirst( TheName , faAnyFile , TheSR );
  { And this is the info }
  Result := TheSR.Size;
  { Needed for win32 }
  {FindClose( TheSR )};
end;

{ This method sets a filename for input of single file data }
function TUUCodingObject.SetInputFileName( TheName : String ) : Boolean;
begin
  { Set the file var to imported name }
  CurrentInputFileName := TheName;
  Result := true;
end;

{ This method sets up an ordered list of files to send through decoding }
procedure TUUCodingObject.SetMultipleFilesList( TheList : TStringList );
begin
  { Set the multiple files list to imported list }
  TheMultipleFilesList := TheList;
end;

{ This method obtains the output file name if file-based output }
{ If not it still gets the output name and saves it.            }
function TUUCodingObject.StartDecoding : Boolean;
var HoldingString ,
    TempName        : String;
    Counter_1       : Integer;
    Through         : Boolean;
begin
  Result := false;
  case CurrentMultiFileVector of
    CMV_SINGLE : begin { Single Input File }
                   TotalBytesSoFar := 0;
                   TotalBytesToDo := GetTextFileSize( CurrentInputFileName );
                   try
                     AssignFile( TheInputFile ,
                                 CurrentInputFileName );
                     Reset( TheInputFile );
                     HoldingString :=
                      ScanLinesForDecodeStartup;
                     if HoldingString = '' then
                     begin
                       AbortCoding( EC_NOBEGIN ,
                                    'No Begin Found!' );
                       Result := false;
                       exit;
                     end
                     else
                     begin
                       CurrentOutputFileName := NewsPath + '\' +
                        HoldingString;
                       try
                         AssignFile( TheOutputFile ,
                          CurrentOutputFileName );
                         Rewrite( TheOutputFile );
                         result := true;
                       except
                         On EInOutError do
                         begin
                           AbortCoding( EC_OUTPUTFILEERROR ,
                            'Error Opening Output File ' );
                           Result := false;
                           exit;
                         end;
                       end;
                     end;
                   except
                     On EInOutError do
                     begin
                       AbortCoding( EC_INPUTFILEERROR ,
                        'Error Opening Input File ' );
                       Result := false;
                       exit;
                     end;
                   end;
                 end;
    CMV_MULTI  : begin { Multiple Input Files }
                   Counter_1 := 0;
                   Through := false;
                   while not Through do
                   begin
                     if ( Counter_1 + 1 ) > TheMultipleFilesList.Count then
                     begin
                       AbortCoding( EC_NOBEGIN , 'No Begin Found!' );
                       Result := false;
                       exit;
                     end;
                     TempName := TheMultipleFilesList.Strings[ Counter_1 ];
                     CurrentInputFileName := TempName;
                     TotalBytesSoFar := 0;
                     TotalBytesToDo := GetTextFileSize( CurrentInputFileName );
                     AssignFile( TheInputFile ,
                                 CurrentInputFileName );
                     Reset( TheInputFile );
                     HoldingString :=
                      ScanLinesForDecodeStartup;
                     if HoldingString <> '' then
                     begin
                       CurrentMFInPointer := Counter_1;
                       CurrentOutputFileName :=
                        HoldingString;
                       try
                         AssignFile( TheOutputFile ,
                          CurrentOutputFileName );
                         Rewrite( TheOutputFile );
                         Through := true;
                         Result := true;
                       except
                         On EInOutError do
                         begin
                           AbortCoding( EC_OUTPUTFILEERROR ,
                            'Error Opening Output File ' );
                           Result := false;
                           exit;
                         end;
                       end;
                     end
                     else
                     begin
                       CloseFile( TheInputFile );
                       Result := false;
                     end;
                   end;
                 end;
  end;
end;

{ This function attempts to decode one or more files and output the bytes }
function TUUCodingObject.Decode : Boolean;
var Through   : Boolean;
    Finished  : Boolean;
    TempName  : String;
begin
  Result := false;
  case CurrentMultiFileVector of
    CMV_SINGLE : begin
                   If not StartDecoding then exit;
                   if DecodeCurrentInputs then
                   begin
                     if Assigned( FOnOutputStatus ) then
                      FOnOutputStatus( TotalBytesToDo , TotalBytesToDo );
                     CloseFile( TheInputFile );
                     CloseFile( TheOutputFile );
                     Result := true;
                     exit;
                   end
                   else
                   begin
                     Result := false;
                     exit;
                   end;
                 end;
    CMV_MULTI  : begin
                   if not StartDecoding then exit;
                   Through := false;
                   while not Through do
                   begin
                     if not DecodeCurrentInputs then
                     begin
                       CloseFile( TheInputFile );
                       CloseFile( TheOutputFile );
                       Result := false;
                       exit;
                     end;
                     if CurrentErrorCode = 2 then
                     begin { Still getting data; keep looking }
                       CurrentMFInPointer := CurrentMFInPointer + 1;
                       if CurrentMFInPointer > TheMultipleFilesList.Count then
                       begin
                         Result := false;
                         CloseFile( TheInputFile );
                         CloseFile( TheOutputFile );
                         exit;
                       end
                       else
                       begin
                         CloseFile( TheInputFile );
                         TempName :=
                          TheMultipleFilesList.Strings[ CurrentMFInPointer ];
                         CurrentInputFileName := TempName;
                        TotalBytesSoFar := 0;
                        TotalBytesToDo := GetTextFileSize( CurrentInputFileName );
                         AssignFile( TheInputFile ,
                                     CurrentInputFileName );
                         Reset( TheInputFile );
                         CurrentLineNumber := 0;
                         Finished := false;
                         CurrentErrorCode := 0;
                         while not Finished do
                         begin
                           GetNextInputFileLine( CurrentLine );
                           if CheckForBEGIN_ENDLine( CurrentLine , 1 ) then
                           begin
                             Finished := true;
                           end
                           else
                           begin
                             if CurrentErrorCode <> 0 then
                             begin
                               AbortCoding( EC_NOBEGIN ,
                                'Multi-File File without BEGIN-' );
                               Result := false;
                               exit;
                             end;
                           end;
                         end;
                       end;
                     end
                     else
                     begin
                       Result := true;
                       CloseFile( TheInputFile );
                       CloseFile( TheOutputFile );
                       Through := true;
                     end;
                   end;
                 end;
  end;
end;

{ This sets the multiple file vector }
procedure TUUCodingObject.SetMultiFileVector( TheVector : Integer );
begin
  CurrentMultiFileVector := TheVector;
end;

{ This is the encoding method; it stuffs everything into one box for simplicity}
function TUUCodingObject.EncodeCurrentInputs : Boolean;
const EncodingOffset          = 32;
      CharactersPerOutputLine = 60;
      BytesPerDataGroup       = 3;
      TotalLinesPerFile       = 900;
      DataBitMask             = $3F;
var EncodingLineLength             ,
    NumberOfBytesProcessed         ,
    CurrentTotalBytesInEncodedLine   : integer;
    OutputLine                       : array [ 0 .. 59 ] of char;
    DataGroup                        : array [ 0 .. 2 ] of byte;
    CharactersToOutput               : array [ 0 .. 3 ] of byte;
    TotalLinesOutputThisFile         : Integer;
    CurrentOutputFileNumber          : Integer;
  { This method writes a full line of output to the destination file }
  procedure WriteOutputLineToFile;
  var Counter_1: integer;
    { This method writes a single character to the dest file, changing space to '}
    procedure WriteSingleCharacterToFile( CurrentCharacter : char );
    begin
      if CurrentCharacter = ' ' then write( TheEncodingOutputFile , '`' )
       else write( TheEncodingOutputFile , CurrentCharacter )
    end;
  begin {WriteOutputLineToFile}
    try
      WriteSingleCharacterToFile( Chr( CurrentTotalBytesInEncodedLine + 32 ));
      for Counter_1 := 0 to EncodingLineLength - 1 do
       WriteSingleCharacterToFile( OutputLine[ Counter_1 ]);
      writeln ( TheEncodingOutputFile );
      TotalLinesOutputThisFile := TotalLinesOutputThisFile + 1;
      EncodingLineLength := 0;
      CurrentTotalBytesInEncodedLine := 0;
      if Assigned( FOnOutputStatus ) then
       FOnOutputStatus( TotalBytesSoFar, TotalBytesToDo );
    except
      On EInOutError do
      begin
        AbortCoding( EC_OUTPUTFILEERROR , 'Unable to write file during encoding' );
        exit;
      end;
    end;
  end;
  { This method sends encoded characters to the output line and sends a full line to file }
  procedure WriteCharsToOutputLine;
  var Counter_1: integer;
  begin
    if EncodingLineLength = 60 then WriteOutputLineToFile;
    CharactersToOutput[ 0 ] := DataGroup[ 0 ] shr 2;
    CharactersToOutput[ 1 ] := ( DataGroup[ 0 ] shl 4 ) + ( DataGroup[ 1 ] shr 4 );
    CharactersToOutput[ 2 ] := ( DataGroup[ 1 ] shl 2 ) + ( DataGroup[ 2 ] shr 6 );
    CharactersToOutput[ 3 ] := DataGroup[ 2 ] and DataBitMask;
    for Counter_1 := 0 to 3 do
    begin
      OutputLine[ EncodingLineLength ] := Chr(( CharactersToOutput[ Counter_1 ]
       and DataBitMask ) + EncodingOffset );
      EncodingLineLength := EncodingLineLength + 1;
    end;
    NumberOfBytesProcessed := 0;
    Inc(  CurrentTotalBytesInEncodedLine , 3 );
  end;
  { This procedure reads in one byte at a time of the input file; when a group }
  { has been accumulated it flushes it into the data line which in turn sends  }
  { it to the output line.                                                     }
  procedure EncodeOneInputByte;
  begin
    if NumberOfBytesProcessed = 3 then WriteCharsToOutputLine;
    try
      seek( TheEncodingInputFile , TotalBytesSoFar );
      read( TheEncodingInputFile , DataGroup[ NumberOfBytesProcessed ]);
    except
      On EInOutError do
      begin
        AbortCoding( EC_INPUTFILEERROR , 'Unable to read file for encoding' );
        exit;
      end;
    end;
    NumberOfBytesProcessed := NumberOfBytesProcessed + 1;
    Inc( TotalBytesSoFar );
  end; {EncodeOneInputByte}
  { This procedure sends out valid final bytes }
  procedure TerminateProperly;
  begin
    try
      if NumberOfBytesProcessed > 0 then WriteCharsToOutputLine;
      if EncodingLineLength > 0 then
      begin
        WriteOutputLineToFile;
        WriteOutputLineToFile;
      end
      else WriteOutputLineToFile;
      writeln( TheEncodingOutputFile , 'end' );
      CloseFile( TheEncodingInputFile );
      CloseFile( TheEncodingOutputFile );
    except
      On EInOutError do
      begin
        AbortCoding( EC_OUTPUTFILEERROR , 'Unable to close files during encoding' );
        exit;
      end;
    end;
  end;
  { This sets up the input and output files }
  procedure ProcessInitialFiles;
  begin
    try
      AssignFile( TheEncodingInputFile , CurrentInputFileName );
      Reset( TheEncodingInputFile );
      AssignFile( TheEncodingOutputFile , ExpandFileName( 'CCOUT001.UUE' ));
      Rewrite( TheEncodingOutputFile );
      Writeln( TheEncodingOutputFile , 'Encoded by CC Internet Command Center V0.158' );
      Writeln( TheEncodingOutputFile , 'File [' , IntToStr( CurrentOutputFileNumber )
       , '] of File ' , LowerCase( ExtractFileName( CurrentInputFileName )));
      Writeln( TheEncodingOutputFile , 'begin 666 ' ,
       LowerCase( ExtractFileName( CurrentInputFileName )));
    except
      On EInOutError do
      begin
        AbortCoding( EC_INPUTFILEERROR , 'Unable to open files for encoding' );
        exit;
      end;
    end;
  end;
  { This closes an output file and opens a new one, updating the name }
  procedure ProcessNewEncodingOutputFile;
  var TempName : String;
  begin
    try
      Writeln( TheEncodingOutputFile , 'END-------CUT HERE----------' );
      CloseFile( TheEncodingOutputFile );
      TempName := IntToStr( CurrentOutputFileNumber + 1 );
      while Length( TempName ) < 3 do TempName := '0' + TempName;
      TempName := 'CCOUT' + TempName + '.UUE';
      AssignFile( TheEncodingOutputFile , ExpandFileName( TempName ));
      Rewrite( TheEncodingOutputFile );
      Writeln( TheEncodingOutputFile , 'Encoded by CC Internet Command Center V0.158' );
      Writeln( TheEncodingOutputFile , 'File [' , IntToStr( CurrentOutputFileNumber )
       , '] of File ' , LowerCase( ExtractFileName( CurrentInputFileName )));
      Writeln( TheEncodingOutputFile , 'BEGIN------CUT HERE----------' );
      CurrentOutputFileNumber := CurrentOutputFileNumber + 1;
      TotalLinesOutputThisFile := 0;
    except
      On EInOutError do
      begin
        AbortCoding( EC_OUTPUTFILEERROR , 'Unable to open files during encoding' );
        exit;
      end;
    end;
  end;
{ This method sets the control variable, reads in all data, and flushes the last buffer }
begin
  CurrentErrorCode := 0;
  EncodingLineLength := 0;
  TotalLinesOutputThisFile := 0;
  CurrentOutputFileNumber := 1;
  NumberOfBytesProcessed := 0;
  CurrentTotalBytesInEncodedLine := 0;
  ProcessInitialFiles;
  if CurrentErrorCode <> 0 then
  begin
    Result := false;
    exit;
  end;
  TotalBytesSoFar := 0;
  TotalBytesToDo := Filesize( TheEncodingInputFile );
  while not eof( TheEncodingInputFile ) do
  begin
    EncodeOneInputByte;
    if CurrentErrorCode <> 0 then
    begin
      Result := false;
      exit;
    end;
    if TotalLinesOutputThisFile > TotalLinesPerFile then
    begin
      ProcessNewEncodingOutputFile;
      if CurrentErrorCode <> 0 then
      begin
        Result := false;
        exit;
      end;
    end;
  end;
  TerminateProperly;
  if CurrentErrorCode <> 0 then
  begin
    Result := false;
    exit;
  end;
  Result := true;
end;

{ This procedure aborts decoding and shuts down the processing }
procedure TUUCodingObject.AbortCoding( AbortCode : Integer; AbortMessage : string);
begin
  { Save abort code }
  CurrentErrorCode := AbortCode;
  { Save error message }
  CurrentErrorMessage := AbortMessage;
  { If error vector set send data to it }
  if Assigned( FOnUUErrorOccurred ) then
   FOnUUErrorOccurred(  CurrentErrorCode , CurrentErrorMessage );
  { shut down input vector }
  CloseFile( TheInputFile );
  { shut down output vector }
  CloseFile( TheOutputFile );
end;

{ Read a line of the Input file }
procedure TUUCodingObject.GetNextInputFileLine( var OutputString : string );
begin
  CurrentLineNumber := CurrentLineNumber + 1;
  try
    Readln( TheInputFile , OutputString );
    TotalBytesSoFar := TotalBytesSoFar + Length( OutputString );
    if Assigned( FOnOutputStatus ) then
     FOnOutputStatus( TotalBytesSoFar, TotalBytesToDo );
  except
    OutputString := '';
    AbortCoding( EC_EOF , 'Unexpected End of File' );
  end;
end;

{ This procedure obtains a space-delimited word from a string }
procedure TUUCodingObject.GetNextSDWord(     TheInputString : String;
                         var WordGotten     : string;
                         var PositionIndex  : integer );
begin
  { Clear output word }
  WordGotten := '';
  { Run along until not at a space }
  while TheInputString[ PositionIndex ] = ' ' do
  begin
    { Increment position index }
    PositionIndex := PositionIndex + 1;
    { if overrun string set error and abort }
    if PositionIndex > length( TheInputString ) then
    begin
      WordGotten := '';
      exit;
    end;
  end;
  { Now run until find a space }
  while TheInputString[ PositionIndex ] <> ' ' do
  begin
    { Add char to the word to get }
    WordGotten := WordGotten + TheInputString[ PositionIndex ];
    { move pointer up }
    PositionIndex := PositionIndex + 1;
    { abort silently if end of line }
    if PositionIndex > length( TheInputString ) then
    begin
      exit;
    end;
  end
end;

{ This takes care of multiple dot UNIX filenames and fn > 12 or 8.3 }
function TUUCodingObject.
 GetAUsableSingleExtensionFileName( InputName : String ) : String;
var HoldingString ,            { Strings to hold data while working }
    TempString      : String;  { more so.                           }
    BestPosition    : Integer; { Holds last period position for ext }
    Counter_1       : Integer; { Loop counter                       }
begin
  { Set no dots found }
  BestPosition := -1;
  { Run loop to find last dot which marks extension }
  for Counter_1 := 1 to Length( InputName ) do
  begin
    { Move counter to last position }
    if InputName[ Counter_1 ] = '.' then BestPosition := Counter_1;
  end;
  { If not found to have an extension }
  if BestPosition = -1 then
  begin
    { Grab first 8 chars, tack on default and exit }
    HoldingString := Copy( InputName , 1 , 8 ) + UUDefaultSuffix;
    Result := HoldingString;
  end
  else
  begin
    { If dotted filename }
    if BestPosition = 1 then
    begin
      { Grab next 8 chars and put on default extension and exit }
      HoldingString := Copy( InputName , 2 , 8 ) + UUDefaultSuffix;
      Result := HoldingString;
    end
    else
    begin
      { copy to working string }
      HoldingString := InputName;
      { Convert all . but last one to _ }
      For Counter_1 := 1 to BestPosition - 1 do
      begin
        { do the conversion }
        if HoldingString[ Counter_1 ] = '.' then
         HoldingString[ Counter_1 ] := '_';
      end;
      { if main name longer than 8 chars set it to that }
      if BestPosition > 9 then
      begin
        { preserve original extension }
        TempString := Copy( HoldingString , BestPosition , 255 );
        HoldingString := Copy( HoldingString , 1 , 8 ) + TempString;
      end;
      { if remaining string longer than 8.3 then has oversize ext }
      if Length( HoldingString ) > 12 then
      begin
        { So trim off all but first 12 chars }
        HoldingString := Copy( HoldingString , 1 , 12 );
      end;
      { and return a result }
      Result := HoldingString;
    end;
  end;
end;

{ This function checks for multipart block headers on lines }
function TUUCodingObject.CheckForBEGIN_ENDLine( InputLine : String;
                                                Vector : Integer ) : boolean;
begin
  Result := false;
  case Vector of
    { BEGIN check }
    1 : begin
          { Do an uppercase; assume standard UU begin-space }
          if Pos( 'BEGIN-' , Uppercase( InputLine )) = 1 then
          begin
            { If find hypenated begin assume cutline }
            Result := true;
          end
          else
          begin
            { Otherwise keep scanning }
            Result := false;
          end;
        end;
    { END check }
    2 : begin
          { Do an uppercase; assume standard UU end only }
          if Pos( 'END-' , Uppercase( InputLine )) = 1 then
          begin
            { If find hyphenated end assume cutline }
            Result := true;
          end
          else
          begin
            if InputLine = '.' then
            begin
              Result := true;
              exit;
            end;
            { Otherwise keep scanning }
            Result := false;
          end;
        end;
  end;
end;

{ This function returns true or false depending on getting output name }
function TUUCodingObject.DecodeOutputName( TheInputString : String ) : String;
var TheIndex     : Integer; { Index counter for double get }
    ResultString : String;  { final result holder          }
begin
  { Check for begin space startup }
  TheIndex := Pos( 'BEGIN ' , Uppercase( TheInputString ));
  { If not found then set to null and exit; }
  if TheIndex <> 1 then
  begin
    Result := '';
    exit;
  end;
  { Set to start of mode integer }
  TheIndex := 7;
  { Clear return var }
  ResultString := '';
  { Get a mode integer }
  GetNextSDWord( TheInputString , ResultString , TheIndex );
  { throw it away }
  ResultString := '';
  { Get a filename }
  GetNextSDWord( TheInputstring , ResultString , TheIndex );
  if ResultString = '' then Result := '' else
   { Return it through filename filter }
   Result := GetAUsableSingleExtensionFileName( ResultString );
end;

{ This method scans for the line containing the filename in Decode }
function TUUCodingObject.ScanLinesforDecodeStartup : String;
var TestLine   ,           { Hold result of line get }
    HoldResult   : String; { Hold result of decode   }
    Through      : Boolean;
begin
  { Set flag }
  Through := false;
  { Run loop }
  while not Through do
  begin
    { Get an input line }
    GetNextInputFileLine( TestLine );
    { If null then hit EOF prematurely; exit }
    if EOF( TheInputFile ) then
    begin
      Result := '';
      exit;
    end;
    { Scan for some kind of file name on line }
    HoldResult := DecodeOutputName( TestLine );
    { If no good then will be ''; otherwise got valid }
    if HoldResult <> '' then
    begin
      { Return the result, set flag and exit }
      Result := HoldResult;
      exit;
    end;
  end;
end;

{ This method scans for the line containing BEGIN- or END- markers }
function TUUCodingObject.ScanLinesforBEGINEND( Vector : Integer ) : Boolean;
var HoldResult   : Boolean; { Hold result of decode   }
    Through      : Boolean;
begin
  Result := false;
  { Set flag }
  Through := false;
  { Run loop }
  while not Through do
  begin
    { Get an input line }
    GetNextInputFileLine( CurrentLine );
    { If null then hit EOF prematurely; exit }
    if CurrentLine = '' then
    begin
      case Vector of
        1 : begin { BEGIN- search }
              Result := false;
              CurrentErrorCode := 1; { File has no data }
              exit;
            end;
        2 : begin { END- search }
              Result := false;
              CurrentErrorCode := 2; { data ended withou END- }
              exit;
            end;
      end;
    end;
    { Scan for some kind of file name on line }
    HoldResult := CheckForBEGIN_ENDLine( CurrentLine , Vector );
    case Vector of
      1 : begin { BEGIN- search }
            if HoldResult then
            begin { BEGIN- found; data will follow }
              Result := true;
              CurrentErrorCode := 0;
              exit;
            end
            else
            begin
              { Keep looking until found or run out of data }
            end;
          end;
      2 : begin { END- search }
            if HoldResult then
            begin  { END- found; need to switch to next file }
              Result := true;
              CurrentErrorCode := 0;
              exit;
            end
            else
            begin  { END- not found; assume data still flowing }
              Result := false;
              CurrentErrorCode := 0;
              exit;
            end;
          end;
    end;
  end;
end;

{ This functin makes sure an input line is not empty or the end symbol }
function TUUCodingObject.CheckForValidLine : boolean;
begin
 { If empty line then signal error and abort }
 if CurrentLine = '' then
 begin
   { Signal abort code and exit }
   AbortCoding( EC_EMPTYDATALINE , 'Empty line in data' );
   Result := false;
   exit;
 end;
 { otherwise check for a space or pseudo-space indicating a 0 line }
 CheckForValidLine := not ( CurrentLine[ 1 ] in [ ' ' , '`' ])
end;

{ Decode a complete line of input text }
procedure TUUCodingObject.DecodeLine;
var LineIndex          ,
    CurrentByteNumber  ,
    ByteCount          ,
    Counter_1            : integer;
    CharactersToDecode   : array [ 0 .. 3 ] of byte;
    BinaryDataToOutput   : array [ 0 .. 2 ] of byte;

  { This internal function gets the next character in the input line }
  function GetNextCharacter : Char;
  begin
    { Increment current character pointer }
    LineIndex := LineIndex + 1;
    { if overrun line then signal error and abort }
    if LineIndex > Length( CurrentLine ) then
    begin
      AbortCoding( EC_UEODL , 'Unexpected End of Character Data in Line');
      Result := Chr( 0 );
      exit;
    end;
    { If hit invalid character then signal error and abort }
    if not ( CurrentLine[ LineIndex ] in [ ' ' .. '`' ]) then
    begin
      AbortCoding( EC_INVALIDCHAR , 'Invalid Character in Data Line');
      Result := Chr( 0 );
      exit;
    end;
    { Do conversion on ' to space and return valid character }
    if CurrentLine[LineIndex] = '`' then
     GetNextCharacter := ' ' else
      GetNextCharacter := CurrentLine[ LineIndex ]
  end;

  { This is an internal procedure to write out a single byte of decoded data }
  procedure DecodeByte;

    { This is an internal procedure to do the decoding and get new data when out }
    procedure GetNextDataGroup;
    var Counter_1 : integer; { Loop Counter }
        Value1    : integer;
    begin
      { Read in }
      for Counter_1 := 0 to 3 do
      begin
        Value1 := Ord( GetNextCharacter ) - UUCodingOffset;
        if Value1 < 0 then exit;
        CharactersToDecode[ Counter_1 ] := Value1;
      end;
      { Do binary bit shifts and additions to create real binary data }
      BinaryDataToOutput[ 0 ] := ( CharactersToDecode[ 0 ] shl 2 ) +
        ( CharactersToDecode[ 1 ] shr 4 );
      BinaryDataToOutput[ 1 ] := ( CharactersToDecode[ 1 ] shl 4 ) +
        ( CharactersToDecode[ 2 ] shr 2 );
      BinaryDataToOutput[ 2 ] := ( CharactersToDecode[ 2 ] shl 6 ) +
        CharactersToDecode[ 3 ];
      CurrentByteNumber := 0;
    end;

  { Begin DecodeByte procedure }
  begin
    { Clear error flag }
    CurrentErrorCode := 0;
    { If at end of current data get next group }
    if CurrentByteNumber = 3 then GetNextDataGroup;
    { If any error occurs exit at once }
    if CurrentErrorCode <> 0 then exit;
    { Write output bytes }
    Write( TheOutputFile , BinaryDataToOutput[ CurrentByteNumber ]);
    { Increment current byte number (note that it resets to 0 so won't overrun end}
    CurrentByteNumber := CurrentByteNumber + 1;
  end;

{ Begin decode line procedure }
begin
  { Set start of data to 0; will be pre-incremented }
  LineIndex := 0;
  { Signal need for new data }
  CurrentByteNumber := 3;
  { Determine how many bytes on current line by  }
  { Getting first character's ordinal value - 32 }
  ByteCount := ( Ord( GetNextCharacter ) - UUCodingOffset );
  { Run that many characters through the decode byte procedure }
  { Which writes out bytes to output streams and gets new data }
  { every three bytes. If less than 3 output bytes in last set }
  { padding will be ignored.                                   }
  for Counter_1 := 1 to ByteCount do DecodeByte
end;

{ This is the core decoding procedure for a current input stream }
function TUUCodingObject.DecodeCurrentInputs : Boolean;

  { This is an internal function to get an input line }
  function GetAnInputLine : Boolean;
  begin
    Result := true;
    case CurrentMultiFileVector of
      0 : begin { Single file decode; no END- issues }
            CurrentErrorCode := 0;
            GetNextInputFileline( CurrentLine );
            if CurrentErrorCode <> 0 then exit;
            result := true;
            exit;
          end;
      1 : begin { Multiple file decode; must check for END- }
            if ScanLinesForBEGINEND( 2 ) then
            begin { END found; exit }
              CurrentErrorCode := 2;
              Result := true;
              exit;
            end
            else
            begin { END not found; check for end of file }
              if CurrentErrorCode = 2 then
              begin { Premature EOF; accept in multifile OK }
                Result := true;
                exit;
              end
              else
              begin  { Either fatal error or OK line }
                if CurrentErrorCode < 0 then
                begin { Fatal error; abort }
                  Result := false;
                  exit;
                end
                else
                begin
                  Result := true;
                  exit;
                end;
              end;
            end;
          end;
    end;
  end;

{ Begin DecodeCurrentInputs function }
begin
  { If can't get valid input line then exit; }
  if not GetAnInputLine then
  begin
    Result := false;
    exit;
  end;
  { If hit end of data in multiline environment then exit OK }
  if (( CurrentMultiFileVector = CMV_MULTI ) and ( CurrentErrorCode = 2 )) then
  begin
    Result := true;
    exit;
  end;
  { If hit end of data in single file environment signal error }
  if CurrentErrorCode = 2 then
  begin
    Result := false;
    exit;
  end;
  Result := true;
  { Run a check for a non-zero line; when hit zero line exit OK }
  while CheckForValidLine do
  begin
    { Decode entire line to appropriate output vector }
    DecodeLine;
    { If can't get valid input line then exit; }
    if not GetAnInputLine then
    begin
      Result := false;
      exit;
    end;
    { If hit end of data in multiline environment then exit OK }
    if (( CurrentMultiFileVector = CMV_MULTI ) and ( CurrentErrorCode = 2 )) then
    begin
      Result := true;
      exit;
    end;
    { If hit end of data in single file environment signal error }
    if CurrentErrorCode = 2 then
    begin
      Result := false;
      exit;
    end;
  end;
end;

end.